Covid19 Japanが独自に収集している陽性確定者単位のデータ。ソースとデータは全てGitHubにて公開されているが、データはJSON形式である点に注意。発表後に修正されたレコード(インスタンス)は削除されれずにステータスなどが変更されているだけなので、「レコード数 \(\neq\) 累計陽性確定者」である点に注意。
Covid19 JapanがGitHubで公開しているデータはJSOM形式のため、また、最新データがインデックスで示されているため、読み込むには少し工夫が必要である。
陽性者単位のデータ。
path <- "https://raw.githubusercontent.com/reustle/covid19japan-data/master/docs/patient_data/"
data_at <- readr::read_lines(paste0(path, "latest.json")) %>%
stringr::str_sub(start = 1L, end = -6L)
df <- path %>%
paste0("latest.json") %>%
readr::read_lines() %>%
paste0(path, .) %>%
jsonlite::fromJSON()
df
死亡者数や重症者数などの推移データはsummaryフォルダ内のJSON形式ファイルにまとめられている。summaryフォルダの他にsummary_minフォルダというフォルダがあるが、summary_minフォルダ内のJSONファイルは改行を省略した形式のファイル。
path <- "https://raw.githubusercontent.com/reustle/covid19japan-data/master/docs/summary/"
df_s <- path %>%
paste0("latest.json") %>%
readr::read_lines() %>%
paste0(path, .) %>%
jsonlite::fromJSON()
df_s %>% summary()
## Length Class Mode
## prefectures 27 data.frame list
## regions 12 data.frame list
## daily 37 data.frame list
## updated 1 -none- character
要約すると分かるが、3つのデータフレームと一つのベクトルから構成されている。参考までに各データの内容を簡単に紹介する。
厳密には都道府県+空港検疫・ダイヤモンドプリンセス・長崎クルーズ船・その他の51区分になっておえい、一部の変量(フィーチャー)がネストされている。
df_s$prefectures
いわゆる八地方区分単位で集計されているデータ。こちらも都道府県単位集計と同様に一部の変量(フィーチャー)がネストされている。ただし、ネストされている変量(フィーチャー)を展開・集計しても集計値とは異なっている。
df_s$regions
発表があった日ごとにまとめているデータ(個票データを集計したもの)。最初の行(インスタンス、レコード)の日付がおかしい点に注意(他のデータから推測すると恐らく“2020-01-08”)。
df_s$daily
集計データファイル(JSON形式)の更新日時が記録されている。
df_s$updated
## [1] "2020-11-02T23:09:44+09:00"
まず、オリジナルのデータがどのようになっているかskimrパッケージを用いてサマライズしておく。
df %>%
skimr::skim()
| Name | Piped data |
| Number of rows | 104087 |
| Number of columns | 23 |
| _______________________ | |
| Column type frequency: | |
| character | 19 |
| logical | 3 |
| numeric | 1 |
| ________________________ | |
| Group variables | None |
Variable type: character
| skim_variable | n_missing | complete_rate | min | max | empty | n_unique | whitespace |
|---|---|---|---|---|---|---|---|
| patientId | 0 | 1.00 | 1 | 8 | 0 | 102428 | 0 |
| dateAnnounced | 0 | 1.00 | 10 | 10 | 0 | 279 | 0 |
| gender | 14180 | 0.86 | 1 | 1 | 0 | 2 | 0 |
| detectedPrefecture | 0 | 1.00 | 3 | 15 | 0 | 49 | 0 |
| patientStatus | 100131 | 0.04 | 8 | 23 | 0 | 8 | 0 |
| notes | 53913 | 0.48 | 1 | 270 | 0 | 47412 | 1 |
| mhlwPatientNumber | 103638 | 0.00 | 1 | 11 | 0 | 434 | 0 |
| prefecturePatientNumber | 12018 | 0.88 | 5 | 20 | 0 | 92060 | 0 |
| prefectureSourceURL | 72783 | 0.30 | 5 | 224 | 0 | 3439 | 0 |
| residence | 22022 | 0.79 | 1 | 38 | 0 | 1422 | 0 |
| sourceURL | 637 | 0.99 | 1 | 239 | 0 | 7939 | 0 |
| relatedPatients | 93691 | 0.10 | 2 | 259 | 0 | 6345 | 0 |
| knownCluster | 101605 | 0.02 | 3 | 88 | 0 | 229 | 0 |
| detectedCityTown | 78088 | 0.25 | 2 | 22 | 0 | 663 | 0 |
| cityPrefectureNumber | 78353 | 0.25 | 1 | 34 | 0 | 25725 | 2 |
| citySourceURL | 92255 | 0.11 | 9 | 317 | 0 | 3637 | 0 |
| deceasedDate | 102290 | 0.02 | 10 | 10 | 0 | 229 | 0 |
| deceasedReportedDate | 102873 | 0.01 | 10 | 62 | 0 | 204 | 0 |
| deathSourceURL | 103017 | 0.01 | 14 | 123 | 0 | 651 | 0 |
Variable type: logical
| skim_variable | n_missing | complete_rate | mean | count |
|---|---|---|---|---|
| confirmedPatient | 0 | 1 | 0.98 | TRU: 102427, FAL: 1660 |
| charterFlightPassenger | 104073 | 0 | 1.00 | TRU: 14 |
| cruisePassengerDisembarked | 104076 | 0 | 1.00 | TRU: 11 |
Variable type: numeric
| skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
|---|---|---|---|---|---|---|---|---|---|---|
| ageBracket | 0 | 1 | 32.65 | 23.57 | -1 | 20 | 30 | 50 | 100 | ▅▇▅▂▁ |
元がJSON形式なので、読み込んだ直後は殆どの変量(フィーチャー)が文字型になっていることが分かる。また、意外と欠損が多いことも分かるので、欠損が非常に多い変量は除いておくことにする。
各変量(フィーチャー)を適切な形式に変換し、地域区分でも分析できるように都道府県データと結合します。
x <- df %>%
dplyr::select(patientId, date = dateAnnounced, gender,
pref = detectedPrefecture, patientStatus, knownCluster,
confirmedPatient, charterFlightPassenger,
cruisePassengerDisembarked, ageBracket,
deceasedDate, deceasedReportedDate) %>%
dplyr::filter(confirmedPatient == TRUE) %>%
dplyr::mutate(date = lubridate::as_date(date),
gender = forcats::as_factor(gender),
patientStatus = forcats::as_factor(patientStatus),
cluster = dplyr::if_else(!is.na(knownCluster), TRUE, FALSE),
ageBracket = forcats::as_factor(ageBracket),
deceasedDate = lubridate::as_date(deceasedDate),
deceasedReportedDate = lubridate::as_date(deceasedReportedDate)) %>%
dplyr::left_join(prefs, by = c("pref" = "pref")) %>%
dplyr::rename(Pref = `都道府県`, region = `八地方区分`, population = `推計人口`)
## Warning: Problem with `mutate()` input `deceasedReportedDate`.
## ℹ 2 failed to parse.
## ℹ Input `deceasedReportedDate` is `lubridate::as_date(deceasedReportedDate)`.
## Warning: 2 failed to parse.
x
x %>%
skimr::skim()
| Name | Piped data |
| Number of rows | 102427 |
| Number of columns | 20 |
| _______________________ | |
| Column type frequency: | |
| character | 3 |
| Date | 3 |
| factor | 9 |
| logical | 4 |
| numeric | 1 |
| ________________________ | |
| Group variables | None |
Variable type: character
| skim_variable | n_missing | complete_rate | min | max | empty | n_unique | whitespace |
|---|---|---|---|---|---|---|---|
| patientId | 0 | 1.00 | 1 | 8 | 0 | 102427 | 0 |
| pref | 0 | 1.00 | 3 | 15 | 0 | 49 | 0 |
| knownCluster | 99974 | 0.02 | 3 | 88 | 0 | 227 | 0 |
Variable type: Date
| skim_variable | n_missing | complete_rate | min | max | median | n_unique |
|---|---|---|---|---|---|---|
| date | 0 | 1 | 2020-01-15 | 2020-11-02 | 2020-08-12 | 279 |
| deceasedDate | 102048 | 0 | 2020-02-13 | 2020-10-17 | 2020-05-08 | 150 |
| deceasedReportedDate | 102097 | 0 | 2020-02-13 | 2020-10-17 | 2020-05-16 | 131 |
Variable type: factor
| skim_variable | n_missing | complete_rate | ordered | n_unique | top_counts |
|---|---|---|---|---|---|
| gender | 13543 | 0.87 | FALSE | 2 | M: 49916, F: 38968 |
| patientStatus | 99894 | 0.02 | FALSE | 8 | Hos: 1261, Dec: 371, Hom: 315, Dis: 283 |
| ageBracket | 0 | 1.00 | FALSE | 13 | 20: 24465, 30: 15417, -1: 13642, 40: 12751 |
| pcode | 1203 | 0.99 | FALSE | 47 | 13: 31323, 27: 12950, 14: 8812, 23: 6326 |
| Pref | 1203 | 0.99 | FALSE | 47 | 東京都: 31323, 大阪府: 12950, 神奈川: 8812, 愛知県: 6326 |
| region | 1203 | 0.99 | FALSE | 8 | 関東地: 53296, 近畿地: 20358, 九州地: 10913, 中部地: 9917 |
| 広域圏 | 7869 | 0.92 | FALSE | 8 | 首都圏: 53514, 近畿圏: 19791, 中部圏: 8590, 九州圏: 7537 |
| 通俗的区分 | 1203 | 0.99 | FALSE | 11 | 関東: 53296, 関西: 19791, 東海: 8247, 九州: 7537 |
| fct_pref | 1203 | 0.99 | FALSE | 47 | Tok: 31323, Osa: 12950, Kan: 8812, Aic: 6326 |
Variable type: logical
| skim_variable | n_missing | complete_rate | mean | count |
|---|---|---|---|---|
| confirmedPatient | 0 | 1 | 1.00 | TRU: 102427 |
| charterFlightPassenger | 102413 | 0 | 1.00 | TRU: 14 |
| cruisePassengerDisembarked | 102416 | 0 | 1.00 | TRU: 11 |
| cluster | 0 | 1 | 0.02 | FAL: 99974, TRU: 2453 |
Variable type: numeric
| skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
|---|---|---|---|---|---|---|---|---|---|---|
| population | 1203 | 0.99 | 8369.87 | 4349.33 | 560 | 5286 | 8813 | 13822 | 13822 | ▅▃▅▆▇ |
文字型を因子型に変換するだけでも大まかな傾向が見える。例えば
ことが読める。
parientStatusは症状(状態)と状況が混在しているため、分かりにくいが以下の通りである。なお、Unspecifiedとは別に欠損値(NA)もある。
| levels | 意味 |
|---|---|
| Hospitalized | 入院中 |
| Critical (Hospitalized) | 重症(入院中) |
| Home Quarantine | 自宅療養中 |
| Hotel Quarantine | ホテル療養中 |
| Recoverd | 回復 |
| Discharged | 退院済 |
| Deceased | 死亡 |
| Unspecified | 詳細不明 |
都道府県別の総陽性者数を求め、上位10県と下位10県を求めてみる。
x %>%
dplyr::group_by(Pref) %>%
dplyr::summarise(n = n())
x %>%
dplyr::group_by(Pref, region) %>%
dplyr::summarise(n = n()) %>%
dplyr::ungroup() %>%
dplyr::slice_max(order_by = n, n = 10)
x %>%
dplyr::group_by(Pref, region) %>%
dplyr::summarise(n = n()) %>%
dplyr::ungroup() %>%
dplyr::slice_min(order_by = n, n = 10)
x %>%
dplyr::group_by(Pref, region) %>%
dplyr::summarise(n = n()) %>%
dplyr::ungroup() %>%
dplyr::group_by(region) %>%
dplyr::summarise(n = sum(n)) %>%
tidyr::pivot_wider(names_from = region, values_from = n)
x %>%
dplyr::group_by(date, region) %>%
dplyr::summarise(n = n()) %>%
dplyr::ungroup() %>%
tidyr::pivot_wider(names_from = region, values_from = n) %>%
dplyr::rename(`その他` = "NA") %>%
tidyr::complete(date = seq.Date(from = lubridate::as_date("2020-01-08"),
to = max(date), by = "day")) %>%
tidyr::pivot_longer(cols = -date, names_to = "regions", values_to = "n") %>%
tidyr::replace_na(list(n = 0L)) %>%
tidyr::pivot_wider(names_from = regions, values_from = n) %>% print() %>%
dplyr::summarise_if(is.integer, .funs = sum)
## # A tibble: 300 x 10
## date 関東地方 中部地方 北海道地方 近畿地方 その他 九州地方 四国地方
## <date> <int> <int> <int> <int> <int> <int> <int>
## 1 2020-01-08 0 0 0 0 0 0 0
## 2 2020-01-09 0 0 0 0 0 0 0
## 3 2020-01-10 0 0 0 0 0 0 0
## 4 2020-01-11 0 0 0 0 0 0 0
## 5 2020-01-12 0 0 0 0 0 0 0
## 6 2020-01-13 0 0 0 0 0 0 0
## 7 2020-01-14 0 0 0 0 0 0 0
## 8 2020-01-15 1 0 0 0 0 0 0
## 9 2020-01-16 0 0 0 0 0 0 0
## 10 2020-01-17 0 0 0 0 0 0 0
## # … with 290 more rows, and 2 more variables: 東北地方 <int>, 中国地方 <int>
日次の陽性者数、前日比、累計を求める。
x %>%
dplyr::group_by(date) %>%
dplyr::summarise(n = n()) %>%
tidyr::complete(date = seq.Date(from = min(date), to = max(date), by = "day"),
fill = list(n = 0L)) %>%
dplyr::mutate(diff = n - dplyr::lag(n, default = 0L), cum = cumsum(n))
x_prefs <- x %>%
dplyr::group_by(date, Pref) %>%
dplyr::summarise(n = n()) %>%
dplyr::ungroup() %>%
tidyr::pivot_wider(names_from = Pref, values_from = n, values_fill = 0L) %>%
tidyr::pivot_longer(cols = -date, names_to = "Pref", values_to = "n")
x_prefs
lagdiff <- function(n) {
n - dplyr::lag(n, default = 0L)
}
x_prefs_diff <- x_prefs %>%
tidyr::pivot_wider(names_from = Pref, values_from = n, values_fill = 0L) %>%
dplyr::mutate_if(is.integer, .funs = lagdiff) %>%
tidyr::pivot_longer(cols = -date, names_to = "Pref", values_to = "diff")
x_prefs_diff
x_prefs_cum <- x_prefs %>%
tidyr::pivot_wider(names_from = Pref, values_from = n, values_fill = 0L) %>%
dplyr::mutate_if(is.integer, .funs = cumsum) %>%
tidyr::pivot_longer(cols = -date, names_to = "Pref", values_to = "cum")
x_prefs_cum
x_by_prefs <- x_prefs %>%
dplyr::left_join(x_prefs_diff, by = c("date" = "date", "Pref" = "Pref")) %>%
dplyr::left_join(x_prefs_cum, by = c("date" = "date", "Pref" = "Pref")) %>%
dplyr::left_join(prefs, ., by = c("都道府県" = "Pref")) %>%
dplyr::mutate(Pref = forcats::fct_inorder(`都道府県`)) %>%
dplyr::select(date, Pref, n, diff, cum) %>%
dplyr::arrange(date)
x_by_prefs
x_region <- x %>%
dplyr::group_by(date, region) %>%
dplyr::summarise(n = n()) %>%
dplyr::ungroup() %>%
tidyr::pivot_wider(names_from = region, values_from = n, values_fill = 0L) %>%
tidyr::pivot_longer(cols = -date, names_to = "region", values_to = "n")
x_region
lagdiff <- function(n) {
n - dplyr::lag(n, default = 0L)
}
x_region_diff <- x_region %>%
tidyr::pivot_wider(names_from = region, values_from = n, values_fill = 0L) %>%
dplyr::mutate_if(is.integer, .funs = lagdiff) %>%
tidyr::pivot_longer(cols = -date, names_to = "region", values_to = "diff")
x_region_diff
x_region_cum <- x_region %>%
tidyr::pivot_wider(names_from = region, values_from = n, values_fill = 0L) %>%
dplyr::mutate_if(is.integer, .funs = cumsum) %>%
tidyr::pivot_longer(cols = -date, names_to = "region", values_to = "cum")
x_region_cum
x_by_region <- x_region %>%
dplyr::left_join(x_region_diff, by = c("date" = "date", "region" = "region")) %>%
dplyr::left_join(x_region_cum, by = c("date" = "date", "region" = "region")) %>%
dplyr::left_join(prefs, ., by = c("八地方区分" = "region")) %>%
dplyr::mutate(region = forcats::fct_inorder(`八地方区分`)) %>%
dplyr::select(date, region, n, diff, cum) %>%
dplyr::arrange(date)
x_by_region
sec_scale <- 100
ncol <- 5
x_by_prefs %>%
ggplot2::ggplot(ggplot2::aes(x = date)) +
ggplot2::geom_bar(ggplot2::aes(y = n, fill = Pref), stat = "identity",
alpha = 0.25, width = 1.0) +
ggplot2::geom_line(ggplot2::aes(y = cum / sec_scale, colour = Pref)) +
ggplot2::facet_wrap(~ Pref, ncol = ncol) +
ggplot2::theme(legend.position = 'none') +
ggplot2::labs(title = "Fixed scale", x = "", y = "") +
ggplot2::scale_y_continuous(
name = "陽性者(単日)",
sec.axis = ggplot2::sec_axis(~ . * sec_scale,
name = "累積陽性者数(折線)")
)
x_by_prefs %>%
ggplot2::ggplot(ggplot2::aes(x = date)) +
ggplot2::geom_bar(ggplot2::aes(y = n, fill = Pref), stat = "identity",
alpha = 0.25, width = 1.0) +
ggplot2::geom_line(ggplot2::aes(y = cum / sec_scale, colour = Pref)) +
ggplot2::facet_wrap(~ Pref, ncol = ncol, scales = "free_y") +
ggplot2::theme(legend.position = 'none') +
ggplot2::labs(title = "Free Y scale", x = "", y = "") +
ggplot2::scale_y_continuous(
name = "陽性者(単日)",
sec.axis = ggplot2::sec_axis(~ . * sec_scale,
name = "累積陽性者数(折線)")
)
sec_scale <- 10
x_by_region %>%
ggplot2::ggplot(ggplot2::aes(x = date)) +
ggplot2::geom_bar(ggplot2::aes(y = n, fill = region), stat = "identity",
alpha = 0.25, width = 1.0) +
ggplot2::geom_line(ggplot2::aes(y = cum / sec_scale, colour = region)) +
ggplot2::facet_wrap(~ region) +
ggplot2::theme(legend.position = 'none') +
ggplot2::labs(title = "Fixed scale", x = "", y = "") +
ggplot2::scale_y_continuous(
name = "陽性者(単日)",
sec.axis = ggplot2::sec_axis(~ . * sec_scale,
name = "累積陽性者数(折線)")
)
x_by_region %>%
ggplot2::ggplot(ggplot2::aes(x = date)) +
ggplot2::geom_bar(ggplot2::aes(y = n, fill = region), stat = "identity",
alpha = 0.25, width = 1.0) +
ggplot2::geom_line(ggplot2::aes(y = cum / sec_scale, colour = region)) +
ggplot2::facet_wrap(~ region, scales = "free_y") +
ggplot2::theme(legend.position = 'none') +
ggplot2::labs(title = "Free Y scale", x = "", y = "") +
ggplot2::scale_y_continuous(
name = "陽性者(単日)",
sec.axis = ggplot2::sec_axis(~ . * sec_scale,
name = "累積陽性者数(折線)")
)